home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 22 / AACD 22.iso / AACD / Programming / powerd / source / h2m.d < prev    next >
Encoding:
Text File  |  2001-02-13  |  25.8 KB  |  1,082 lines
  1. //
  2. // h2m.d - c include into d ascii module converter by Martin <MarK> Kuchinka (2000-2001)
  3. //
  4. // history:
  5. // 1.0 initial release
  6. //
  7. // 1.1 1.7.2000
  8. //   - added enumerations
  9. //
  10. // 1.2 18.11.2000
  11. //   - '*' doesn't have to be right before the name in structure definition
  12. //
  13. // 1.3 14.1.2001
  14. //   - now the source name can contain the '.h'
  15. //   - now removes the 'xxx_' in 'xxx_yyy' in item names
  16. //   - added recognition for function pointers in structures, requires dc v0.17 or newer
  17. //   - added typedef support, requires dc v0.17 or newer
  18. //
  19. // 1.4 10.2.2001
  20. //   - structs defined by union keyword are now recognised
  21. //
  22. // todo:
  23. // macro to constant optimizer
  24.  
  25. OPT    OPTIMIZE
  26.  
  27. MODULE    'exec/memory'
  28.  
  29. RAISE    "^C"  IF CtrlC()=TRUE,
  30.         "MEM" IF AllocPooled()=NIL,
  31.         "MEM" IF AllocVecPooled()=NIL
  32.  
  33. ENUM    SOURCE,NOCOMMENT,OPTIMIZE
  34. SET    F_NOCOMMENT,F_OPTIMIZE
  35.  
  36. DEF    pool,flags=0
  37.  
  38. BYTE '\n\n$VER: h2m v1.4 by MarK (10.2.2001)\n\n\n\0'
  39.  
  40. PROC main()
  41.     DEF    args:PTR TO LONG,ra,
  42.             name[256]:STRING,dest[256]:STRING,
  43.             src:PTR TO CHAR,l,f=NIL,data
  44.     args:=[NIL,FALSE,FALSE]:LONG
  45.     IFN ra:=ReadArgs('SOURCE/A,NC=NOCOMMENT/S,O=OPTIMIZE/S',args,NIL) THEN Raise("DOS")
  46.     IF StrCmp(args[SOURCE]+StrLen(args[SOURCE])-2,'.h')
  47.         StrCopy(name,args[SOURCE])
  48.         StrCopy(dest,args[SOURCE])
  49.         dest[StrLen(dest)-1]:="m"
  50.     ELSE
  51.         StringF(name,'\s.h',args[SOURCE])
  52.         StringF(dest,'\s.m',args[SOURCE])
  53.     ENDIF
  54.     IF args[NOCOMMENT] THEN flags:=F_NOCOMMENT
  55.     IF args[OPTIMIZE] THEN flags|=F_OPTIMIZE
  56.     IF (l:=FileLength(name))<=0 THEN Raise("DOS")
  57.     IFN pool:=CreatePool(MEMF_PUBLIC|MEMF_CLEAR,16384,4096) THEN Raise("MEM")
  58.     src:=AllocVecPooled(pool,l+16)
  59.     IF f:=Open(name,OLDFILE)
  60.         Read(f,src,l)
  61.         Close(f)
  62.         f:=NIL
  63.         data:=ReadC(src,l)
  64.     ELSE Raise("DOS")
  65.     IF flags & F_OPTIMIZE THEN Optimize(data)
  66.     IF f:=Open(dest,NEWFILE)
  67.         WriteD(f,data)
  68.         VFPrintF(f,'\n',NIL)
  69.         Close(f)
  70.         f:=NIL
  71.     ELSE Raise("DOS")
  72. EXCEPTDO
  73.     SELECT exception
  74.     CASE "DOS";    PrintFault(IOErr(),'h2m')
  75.     CASE "MEM";    PrintF('\s: not enough memory\n','h2m')
  76.     CASE "EOF";    PrintF('\s: unexpected eof (\d)\n','h2m',exceptioninfo)
  77.     CASE "^C";    PrintF('\s: ***break \s\n','h2m',exceptioninfo)
  78.     CASE "TYP";    PrintF('\s: unknown type (\d)\n','h2m',exceptioninfo)
  79.     CASE "PTR";    PrintF('\s: too deep pointer (\d)\n','h2m',exceptioninfo)
  80.     CASE "STX";    PrintF('\s: syntax error (\d)\n','h2m',exceptioninfo)
  81.     ENDSELECT
  82.     IF f THEN Close(f)
  83.     IF pool THEN DeletePool(pool)
  84.     IF ra THEN FreeArgs(ra)
  85. ENDPROC
  86.  
  87. OBJECT data
  88.     what:WORD,            // DA...
  89.     next:PTR TO macro
  90.  
  91. ENUM    DA_None,
  92.         DA_Comment,
  93.         DA_OBJECT,        // struct
  94.         DA_UNION,
  95.         DA_ITEM,
  96.         DA_ENUM,            // enum
  97.         DA_Macro,
  98.         DA_TDEF,            // typedef
  99.         DA_OConst        // constant generated by optimizer
  100.  
  101. OBJECT comment OF data
  102.     comment:PTR TO CHAR
  103.  
  104. OBJECT obj OF data
  105.     name:PTR TO CHAR,
  106.     comment:PTR TO comment,
  107.     item:PTR TO item
  108.  
  109. OBJECT item OF data
  110.     name:PTR TO CHAR,
  111.     comment:PTR TO comment,
  112.     type:UBYTE,                // DT...
  113.     flags:UBYTE,            // IF...
  114.     size:LONG,
  115.     obj:PTR TO CHAR        // obj/NIL
  116.  
  117. OBJECT enum OF data
  118.     first:PTR TO const
  119.  
  120. OBJECT const
  121.     next:PTR TO const,
  122.     name:PTR TO CHAR,
  123.     value:LONG,
  124.     comment:PTR TO comment
  125.  
  126. SET    IF_UNION,                    // item is an UNION
  127.         IF_FUNC
  128.  
  129. ENUM    DT_VOID,                        // cut from dc.e
  130.         DT_LONG,
  131.         DT_ULONG,
  132.         DT_WORD,
  133.         DT_UWORD,
  134.         DT_BYTE,
  135.         DT_UBYTE,
  136.         DT_FLOAT,
  137.         DT_DOUBLE,
  138.         DT_BOOL,
  139.         DT_CUSTOM,                    -> object - global field
  140.         DT_PTR,                        -> VOID pointer
  141.         DT_DLONG,
  142.         DT_UDLONG,
  143.         DT_STRING,
  144.         DT_BASE,
  145.         DT_FUNC                        // function pointer
  146.  
  147. OBJECT macro OF data
  148.     type:WORD,
  149.     name:PTR TO CHAR,
  150.     args:PTR TO CHAR,
  151.     comment:PTR TO CHAR,
  152.     mline:PTR TO mline
  153.  
  154. ENUM    MT_define,
  155.         MT_include,
  156.         MT_ifdef,
  157.         MT_ifndef,
  158.         MT_endif
  159.  
  160. OBJECT mline
  161.     next:PTR TO mline,
  162.     data:PTR TO CHAR,
  163.     comment:PTR TO CHAR
  164.  
  165. OBJECT typedef OF data
  166.     type:WORD,                        // DT...
  167.     obj:PTR TO CHAR,
  168.     name:PTR TO CHAR,                // new type name
  169.     object:PTR TO obj
  170.  
  171. OBJECT oconst OF data
  172.     name:PTR TO CHAR,
  173.     value:LONG,
  174.     comment:PTR TO comment
  175.  
  176. PROC ReadC(src:PTR TO CHAR,l)(L)
  177.     DEF    last=NIL:PTR TO data,frst=NIL:PTR TO data,pos=0,
  178.             data:PTR TO data,name[80]:CHAR
  179.     WHILE pos<l
  180.         data:=NIL
  181.         pos:=Crop(src,pos,l)
  182.         IF (src[pos]="/"&&src[pos+1]="/")||(src[pos]="/"&&src[pos+1]="*")
  183.             pos,data:=Comment(src,pos,l)
  184.         ELSEIF src[pos]="#"
  185.             pos,data:=Macro(src,pos,l)
  186.         ELSE
  187.             pos:=GetName(name,src,pos,l)
  188.             IF StrCmp(name,'struct')
  189.                 pos,data:=OBJECT(src,pos,l)
  190.             ELSEIF StrCmp(name,'union')
  191.                 pos,data:=OBJECT(src,pos,l)
  192.             ELSEIF StrCmp(name,'enum')
  193.                 pos,data:=ENUM(src,pos,l)
  194.             ELSEIF StrCmp(name,'typedef')
  195.                 pos,data:=TYPEDEF(src,pos,l)
  196.             ELSE
  197.                 pos++
  198.             ENDIF
  199.             name[0]:="\0"
  200.         ENDIF
  201.         IFN frst THEN frst:=data
  202.         IF  last THEN last.next:=data
  203.         IF  data THEN last:=data
  204.         WHILE last.next DO last:=.next
  205.         CtrlC()
  206.         IF CtrlD() THEN RETURN frst
  207.     EXITIF src[pos]="\0"
  208.     ENDWHILE
  209. ENDPROC frst
  210.  
  211. // read one or more comments if available
  212. PROC Comment(src:PTR TO CHAR,pos,l)(LONG,PTR TO comment)
  213.     DEF    opos=pos,comment=NIL:PTR TO comment,data:PTR TO CHAR,first=NIL:PTR TO comment,
  214.             last=NIL:PTR TO comment
  215.     WHILE src[pos]="/"&&src[pos+1]="/"
  216.         WHILE src[pos]<>"\n"
  217.             pos++
  218.             CtrlC()
  219.         ENDWHILE
  220.     ELSEWHILE src[pos]="/"&&src[pos+1]="*"
  221.         REPEAT
  222.             pos++
  223.             CtrlC()
  224.         UNTIL src[pos]="*"&&src[pos+1]="/"
  225.         pos+=2
  226.     ALWAYS
  227.         IFN flags&F_NOCOMMENT
  228.             comment:=AllocPooled(pool,SIZEOF_comment)
  229.             comment.what:=DA_Comment
  230.             data:=AllocVecPooled(pool,pos-opos+4)
  231.             StrCopy(data,src+opos,pos-opos)
  232.             comment.comment:=data
  233. //            PrintF('(\d) \s\n',opos,data)
  234.             IFN first THEN first:=comment
  235.             IF last THEN last.next:=comment
  236.             last:=comment
  237.         ENDIF
  238. //        pos:=Crop(src,pos,l)
  239.         opos:=pos
  240.     ENDWHILE
  241. ENDPROC pos,first
  242.  
  243. PROC OBJECT(src:PTR TO CHAR,pos,l,union=FALSE)(LONG,PTR TO obj)
  244.     DEF    name[80]:CHAR,obj:PTR TO obj,next=TRUE,item:PTR TO item,type,objn:PTR TO CHAR,
  245.             last=NIL:PTR TO item,ptr,opos,func
  246.     obj:=AllocPooled(pool,SIZEOF_obj)
  247.     IFN union
  248.         obj.what:=DA_OBJECT
  249.         pos:=Skip(src,pos,l)
  250.         pos:=GetName(name,src,pos,l)
  251.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  252.         StrCopy(obj.name,name)
  253.         pos:=Crop(src,pos,l)
  254.         pos,obj.comment:=Comment(src,pos,l)
  255.     ENDIF
  256. //    PrintF('(\d) \s\n',pos,obj.name)
  257.     pos:=Skip(src,pos,l)
  258.     IF src[pos]="{" THEN pos++ //ELSE Raise("STX",pos)
  259.     WHILE next
  260.         opos:=pos:=Skip(src,pos,l)
  261.         pos:=GetName(name,src,pos,l)    // read type
  262. //        PrintF('(\d) \s\n',pos,name)
  263.         objn:=NIL
  264.         func:=FALSE
  265.         next:=TRUE
  266.  
  267.         SELECT TRUE
  268.         CASE StrCmp(name,'int'),StrCmp(name,'long'),StrCmp(name,'LONG')
  269.                                                 type:=DT_LONG
  270.         CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  271.         CASE StrCmp(name,'WORD');        type:=DT_WORD
  272.         CASE StrCmp(name,'void');        type:=DT_VOID
  273.         CASE StrCmp(name,'UWORD');        type:=DT_UWORD
  274.         CASE StrCmp(name,'BYTE');        type:=DT_BYTE
  275.         CASE StrCmp(name,'UBYTE'),StrCmp(name,'char')
  276.                                                 type:=DT_UBYTE
  277.         CASE StrCmp(name,'STRPTR');    type:=DT_UBYTE+%100000
  278.         CASE StrCmp(name,'float');        type:=DT_FLOAT
  279.         CASE StrCmp(name,'double');    type:=DT_DOUBLE
  280.         CASE StrCmp(name,'APTR'),StrCmp(name,'BPTR'),StrCmp(name,'CPTR')
  281.                                                 type:=DT_PTR
  282.         CASE StrCmp(name,'struct');    type:=DT_CUSTOM
  283.             pos:=Skip(src,pos,l)
  284.             IF src[pos]="{"
  285.                 pos,item:=OBJECT(src,pos,l,TRUE)
  286. //                PrintF('(\d) \s\n',pos,item.name)
  287.                 IFN obj.item THEN obj.item:=item
  288.                 IF last THEN last.next:=item
  289.                 last:=item
  290.                 next:=FALSE
  291.             ELSE
  292.                 pos:=GetName(name,src,pos,l)
  293.                 objn:=AllocPooled(pool,StrLen(name)+4)
  294.                 StrCopy(objn,name)
  295.                 pos:=Skip(src,pos,l)
  296.             ENDIF
  297.         CASE StrCmp(name,'union');        type:=DT_CUSTOM
  298.             pos:=Skip(src,pos,l)
  299.             IF src[pos]="{"
  300.                 pos,item:=OBJECT(src,pos,l,TRUE)
  301. //                PrintF('(\d) \s\n',pos,item.name)
  302.                 IFN obj.item THEN obj.item:=item
  303.                 IF last THEN last.next:=item
  304.                 last:=item
  305.                 next:=FALSE
  306.             ELSE
  307.                 pos:=GetName(name,src,pos,l)
  308.                 objn:=AllocPooled(pool,StrLen(name)+4)
  309.                 StrCopy(objn,name)
  310.                 pos:=Skip(src,pos,l)
  311.             ENDIF
  312.         DEFAULT;                                type:=DT_CUSTOM
  313.             objn:=AllocPooled(pool,StrLen(name)+4)
  314.             StrCopy(objn,name)
  315.             pos:=Skip(src,pos,l)
  316. //            Raise("TYP",opos)
  317.         ENDSELECT
  318.  
  319. //        PrintF('type=\d\n',type)
  320.  
  321.         // next is TRUE
  322.         WHILE next
  323.             pos:=Skip(src,pos,l)
  324.             item:=AllocPooled(pool,SIZEOF_item)
  325.             item.what:=DA_ITEM
  326.             item.obj:=objn
  327.             item.type:=type
  328.             IF src[pos]="("
  329.                 func:=TRUE
  330.                 pos:=Skip(src,pos+1,l)
  331.             ENDIF
  332.             ptr:=0
  333.             WHILE src[pos]="*" DO pos++;    ptr++
  334.             pos:=Skip(src,pos,l)
  335.             IF ptr>4 THEN Raise("PTR",pos)
  336.             item.type|=ptr<<5
  337.             pos:=GetName(name,src,pos,l)
  338.             item.name:=AllocPooled(pool,StrLen(name)+4)
  339.             StrCopy(item.name,name)
  340. //            PrintF('(\d) \s(\d)\n',pos,name,ptr)
  341.             pos:=Crop(src,pos,l)
  342.             IF func
  343.                 IF src[pos]=")"
  344.                     pos:=Skip(src,pos+1,l)
  345.                     IF src[pos]="(" THEN pos:=Skip(src,pos+1,l) ELSE Raise("STX",pos)
  346.                     IF src[pos]=")" THEN pos:=Crop(src,pos+1,l) ELSE Raise("STX",pos)
  347.                     item.flags|=IF_FUNC
  348.                 ELSE
  349.                     Raise("STX",pos)
  350.                 ENDIF
  351.             ENDIF
  352. //            PrintF('(\d) \s\n',pos,name)
  353.             IF src[pos]="["
  354. //                PrintF('Yes\n')
  355.                 opos:=++pos
  356.                 pos:=Find("]",src,pos,l)
  357.                 StrCopy(name,src+opos,pos-opos)
  358.                 C2D(name)
  359.                 item.size:=AllocPooled(pool,StrLen(name)+4)
  360.                 StrCopy(item.size,name)
  361.                 pos++
  362.             ENDIF
  363.             pos:=Crop(src,pos,l)
  364.             IF src[pos]=","
  365.                 next:=TRUE
  366.                 pos++
  367.             ELSE
  368.                 next:=FALSE
  369.             ENDIF
  370.             pos:=Crop(src,pos,l)
  371.             pos,item.comment:=Comment(src,pos,l)
  372.             pos:=Skip(src,pos,l)
  373.             IFN obj.item THEN obj.item:=item
  374.             IF last THEN last.next:=item
  375.             last:=item
  376.             CtrlC()
  377.         ENDWHILE
  378.         CtrlC()
  379.     EXITIF src[pos]="}" DO pos:=Crop(src,++pos,l)
  380.         next:=TRUE
  381.     ENDWHILE
  382.     IF union
  383.         obj.what:=DA_UNION
  384.         pos:=Skip(src,pos,l)
  385.         pos:=GetName(name,src,pos,l)
  386. //        PrintF('(\d) \s\n',pos,name)
  387.         obj.name:=AllocPooled(pool,StrLen(name)+4)
  388.         StrCopy(obj.name,name)
  389.         pos:=Crop(src,pos,l)
  390.         pos,obj.comment:=Comment(src,pos,l)
  391.     ENDIF
  392. ENDPROC pos,obj
  393.  
  394. PROC ENUM(src:PTR TO CHAR,pos,l)(LONG,PTR TO ENUM)
  395.     DEF    enum:PTR TO enum,next=TRUE,const:PTR TO const,prev=NIL:PTR TO const
  396.     DEF    name[64]:STRING,value=0
  397.     enum:=AllocPooled(pool,SIZEOF_enum)
  398.     enum.what:=DA_ENUM
  399.     pos:=Skip(src,pos,l)
  400.     pos:=GetName(name,src,pos,l)
  401.     pos:=Skip(src,pos,l)
  402. //    PrintF('\d=\s\n',pos,name)
  403.     IF src[pos]<>"{" THEN Raise("STX",pos) ELSE pos++
  404.     WHILE next
  405.         pos:=Skip(src,pos,l)
  406.         const:=AllocPooled(pool,SIZEOF_const)
  407.         IFN enum.first THEN enum.first:=const
  408.         IF prev THEN prev.next:=const
  409.  
  410.         pos:=GetName(name,src,pos,l)
  411.         const.name:=AllocPooled(pool,StrLen(name)+4)
  412.         StrCopy(const.name,name)
  413.  
  414.         pos:=Skip(src,pos,l)
  415. //        PrintF('1=\d\n',pos)
  416.         IF src[pos]="="
  417.             pos,value:=GetNum(src,pos+1,l)
  418.         ENDIF
  419. //        PrintF('2=\d\n',pos)
  420.  
  421.         const.value:=value
  422.  
  423.         pos:=Crop(src,pos,l)
  424.         pos,const.comment:=Comment(src,pos,l)
  425.         pos:=Skip(src,pos,l)
  426. //        PrintF('3=\d\n',pos)
  427.  
  428. //        PrintF('\s=\d\n',const.name,const.value)
  429.  
  430.         IF src[pos]=","
  431.             pos++
  432.         ELSEIF src[pos]="}"
  433.             next:=FALSE
  434.             pos++
  435.         ELSE
  436.             Raise("STX",pos)
  437.         ENDIF
  438.  
  439.         value++
  440.         prev:=const
  441.     ENDWHILE
  442. ENDPROC pos,enum
  443.  
  444. PROC TYPEDEF(src:PTR TO CHAR,pos,l)(LONG,PTR TO typedef)
  445.     DEF    tdef:PTR TO typedef,name[64]:STRING,type,obj=NIL:PTR TO CHAR,object:PTR TO obj
  446.     tdef:=AllocPooled(pool,SIZEOF_typedef)
  447.     tdef.what:=DA_TDEF
  448.     pos:=Skip(src,pos,l)
  449.     pos:=GetName(name,src,pos,l)
  450.     pos:=Skip(src,pos,l)
  451.     SELECT TRUE
  452.     CASE StrCmp(name,'struct')
  453.         object:=OBJECT(src,pos,l,TRUE)
  454.         object.what:=DA_OBJECT
  455.         type:=DT_CUSTOM
  456.         obj:=object.name
  457.         tdef.object:=object
  458.     CASE StrCmp(name,'short');        type:=DT_WORD
  459.     CASE StrCmp(name,'int');        type:=DT_LONG
  460.     CASE StrCmp(name,'LONG');        type:=DT_LONG
  461.     CASE StrCmp(name,'ULONG');        type:=DT_ULONG
  462.     CASE StrCmp(name,'float');        type:=DT_FLOAT
  463.     CASE StrCmp(name,'double');    type:=DT_DOUBLE
  464.     DEFAULT;                                type:=DT_CUSTOM
  465.         obj:=AllocPooled(pool,StrLen(name)+4)
  466.         StrCopy(obj,name)
  467.     ENDSELECT
  468.     pos:=GetName(name,src,pos,l)
  469.     pos:=Skip(src,pos,l)
  470.     tdef.name:=AllocPooled(pool,StrLen(name)+4)
  471.     StrCopy(tdef.name,name)
  472.  
  473.     tdef.type:=type
  474.     tdef.obj:=obj
  475. ENDPROC pos,tdef
  476.  
  477. PROC Macro(src:PTR TO CHAR,pos,l)(LONG,PTR TO macro)
  478.     DEF    opos,macro=NIL:PTR TO macro,name[80]:STRING,next,ml,
  479.             line:PTR TO mline,last:PTR TO mline,buf[1024]:STRING,cpos
  480.     macro:=AllocPooled(pool,SIZEOF_macro)
  481.     macro.what:=DA_Macro
  482.     pos:=Skip(src,pos,l)
  483.     pos:=GetName(name,src,pos,l)
  484.     IF StrCmp(name,'#define')
  485.         macro.type:=MT_define
  486.         pos:=Skip(src,pos,l)
  487.         pos:=GetName(name,src,pos,l)
  488.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  489.         StrCopy(macro.name,name)
  490.         IF src[pos]="("
  491.             opos:=pos
  492.             pos:=Find(")",src,pos,l)
  493.             macro.args:=AllocPooled(pool,pos-opos+4)
  494.             StrCopy(macro.args,src+opos,pos-opos)
  495.         ENDIF
  496.         next:=TRUE
  497.         last:=NIL
  498.         WHILE next
  499.             opos:=pos
  500.             pos:=MaCrop(src,pos,l)
  501.             line:=AllocPooled(pool,SIZEOF_mline)
  502.             StrCopy(buf,src+opos,pos-opos)
  503.             cpos:=C2D(buf)
  504.             ml:=StrLen(buf)+1
  505.             IF cpos<100000 THEN ml-=ml-cpos
  506.             line.data:=AllocPooled(pool,ml+4)
  507.             StrCopy(line.data,buf,ml-1)
  508. //            PrintF('\s\n',line.data)
  509.             IF src[pos]="\\"
  510.                 pos++
  511.                 next:=TRUE
  512.                 pos:=Crop(src,pos,l)
  513.                 pos,line.comment:=Comment(src,pos,l)
  514.             ELSE
  515.                 next:=FALSE
  516.                 IF cpos<100000 THEN pos,line.comment:=Comment(src,opos+cpos,l)
  517.                 pos++                // skip "\n"
  518.             ENDIF
  519.             IFN macro.mline THEN macro.mline:=line
  520.             IF last THEN last.next:=line
  521.             last:=line
  522.             CtrlC()
  523.         ENDWHILE
  524.     ELSEIF StrCmp(name,'#ifdef')
  525.         macro.type:=MT_ifdef
  526.         pos:=Skip(src,pos,l)
  527.         pos:=GetName(name,src,pos,l)
  528.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  529.         StrCopy(macro.name,name)
  530.     ELSEIF StrCmp(name,'#ifndef')
  531.         macro.type:=MT_ifndef
  532.         pos:=Skip(src,pos,l)
  533.         pos:=GetName(name,src,pos,l)
  534.         macro.name:=AllocPooled(pool,StrLen(name)+4)
  535.         StrCopy(macro.name,name)
  536.     ELSEIF StrCmp(name,'#endif')
  537.         macro.type:=MT_endif
  538.     ELSEIF StrCmp(name,'#include')
  539.         macro.type:=MT_include
  540.         pos:=Skip(src,pos,l)
  541.         IF src[pos]="\q"
  542.             opos:=++pos
  543.             WHILE src[pos]<>"\q" DO pos++
  544.             buf[0]:="*"
  545.             StrCopy(buf+1,src+opos,pos-opos)
  546.         ELSEIF src[pos]="<"
  547.             opos:=++pos
  548.             WHILE src[pos]<>">" DO pos++
  549.             StrCopy(buf,src+opos,pos-opos)
  550.         ENDIF
  551.         ml:=StrLen(buf)
  552.         IF buf[ml-2]="."&&buf[ml-1]="h" THEN buf[ml-2]:="\0"
  553.         macro.name:=AllocPooled(pool,ml+4)
  554.         StrCopy(macro.name,buf)
  555.         pos++                // skip "\q" or ">"
  556.     ENDIF
  557. ENDPROC pos,macro
  558.  
  559. // this function replaces: '->' to '.', '0x' to '$'
  560. PROC C2D(src:PTR TO CHAR)(LONG)
  561.     DEF    spos=0,dpos=0,l=StrLen(src),cpos=100000
  562.     WHILE spos<l        // dpos is always smaller or equal then spos
  563.         IF src[spos]="-"&&src[spos+1]=">"
  564.             src[dpos]:="."
  565.             spos++
  566.         ELSEIF src[spos]="0"&&src[spos+1]="x"
  567.             src[dpos]:="$"
  568.             spos++
  569. //        ELSEIF IsHex(src[spos])&&src[spos+1]="L"
  570.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="L"
  571.             src[dpos]:=src[spos]
  572.             spos++
  573.         ELSEIF src[spos]>="0"&&src[spos]<="9"&&src[spos+1]="U"&&src[spos+2]="L"
  574.             src[dpos]:=src[spos]
  575.             spos+++
  576.         ELSEIF src[spos]="\q"
  577.             src[dpos]:="\a"
  578.         ELSEIF src[spos]="\a"
  579.             src[dpos]:="\q"
  580.         ELSEIF src[spos]="%"
  581.             src[dpos]:="\\"
  582.         ELSEIF src[spos]="/"&&src[spos+1]="/"
  583.             IF cpos=100000 THEN cpos:=spos
  584.         ELSEIF src[spos]="/"&&src[spos+1]="*"
  585.             IF cpos=100000 THEN cpos:=spos
  586.         ELSE
  587.             src[dpos]:=src[spos]
  588.         ENDIF
  589.         spos++
  590.         dpos++
  591.         CtrlC()
  592.     ENDWHILE
  593.     src[dpos]:="\0"
  594. ENDPROC cpos            // position of comment
  595.  
  596. PROC WriteD(f,data:PTR TO macro)
  597.     DEF    prev
  598.     WHILE data
  599.         prev:=data
  600.         // this loop removes #ifndef and #endif lines from destination
  601.         WHILE data.what=DA_Macro&&data.type=MT_ifndef
  602.             DEF    next=data.next:PTR TO macro
  603.             IF next
  604.                 IF next.what=DA_Macro&&next.type=MT_include
  605.                     IF next.next.what=DA_Macro&&next.next.type=MT_endif
  606.                         WriteMacro(f,next)
  607.                         IF next.next THEN IFN data:=next.next.next THEN RETURN
  608.                     ENDIF
  609.                 ENDIF
  610.             ENDIF
  611.         EXITIF prev=data
  612.         ENDWHILE
  613.         SELECT data.what
  614.         CASE DA_Comment;    WriteComment(f,data)
  615.         CASE DA_OBJECT;    WriteOBJECT(f,data)
  616.         CASE DA_ENUM;        WriteENUM(f,data)
  617.         CASE DA_Macro;        WriteMacro(f,data)
  618.         CASE DA_TDEF;        WriteTDEF(f,data)
  619.         CASE DA_OConst;    data:=WriteCONST(f,data)
  620.         ENDSELECT
  621.         data:=.next
  622.         CtrlC()
  623.     ENDWHILE
  624. ENDPROC
  625.  
  626. PROC WriteComment(f,comment:PTR TO comment)
  627.     FPrintF(f,'\s\n',comment.comment)
  628. ENDPROC
  629.  
  630. PROC WriteOBJECT(f,obj:PTR TO obj,level=0)
  631.     DEF    item:PTR TO item,maxl=0,l
  632.  
  633.     item:=obj.item
  634.     ReNameAllItems(item)
  635.  
  636.     // find maximal name length
  637. //    WHILE item DO maxl:=Max(maxl,ItemLen(item));    item:=.next
  638.     WHILE item DO IF (l:=ItemLen(item))>maxl THEN maxl:=l;    item:=.next
  639.  
  640.     IF obj.what=DA_UNION&&level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  641.     FPrintF(f,'OBJECT \s',obj.name)
  642.     IF obj.comment
  643.         l:=StrLen(item)+3
  644.         WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  645.         WriteD(f,obj.comment)
  646.     ELSE
  647.         FPrintF(f,'\n',NIL)
  648.     ENDIF
  649.  
  650.     item:=obj.item
  651.     WHILE item
  652.         IF item.what=DA_UNION
  653.             WriteOBJECT(f,item,level+1)
  654.         ELSE
  655.             FOR l:=0 TO level FPrintF(f,'\t', NIL)
  656.             FPrintF(f,'\s',item.name)
  657.             IF item.flags&IF_FUNC
  658.                 IF (item.type&$1f)<>DT_VOID THEN FPrintF(f,'()(\s\s)',TypeStr(item.type-32),item.obj) ELSE VFPrintF(f,'()')
  659.             ELSE
  660.                 IF item.size THEN FPrintF(f,'[\s]',item.size)
  661.                 FPrintF(f,':\s',TypeStr(item.type))
  662.                 IF item.obj THEN FPrintF(f,item.obj,NIL)
  663.             ENDIF
  664.         ENDIF
  665.         IF item.next THEN FPrintF(f,',',NIL)
  666.         IF item.comment
  667.             l:=ItemLen(item)
  668.             l-=4
  669.             IFN item.next THEN l--
  670.             WHILE l<maxl DO l++;    FPrintF(f,' ',NIL)
  671.             WriteD(f,item.comment)
  672.         ELSE
  673.             FPrintF(f,'\n',NIL)
  674.         ENDIF
  675.         item:=.next
  676.         CtrlC()
  677.     ENDWHILE
  678.     IF obj.what=DA_UNION&&level>0 THEN FOR l:=1 TO level FPrintF(f,'\t', NIL)
  679.     FPrintF(f,IF obj.what=DA_OBJECT THEN '\n' ELSE 'ENDUNION',obj.name)
  680. ENDPROC
  681.  
  682. PROC ReNameAllItems(first:PTR TO item)
  683.     DEF    pre[16]:CHAR,n=0,len,item=first:PTR TO item
  684.  
  685.     // find the "_" to get the
  686.     len:=StrLen(item.name)
  687.     WHILE item.name[n]<>"_"
  688.         IF n=>len THEN RETURN
  689.         pre[n]:=item.name[n]
  690.         n++
  691.     ENDWHILE
  692.     pre[n++]:="_"
  693.     pre[n]:="\0"
  694.  
  695.     WHILE item
  696.         IF StrCmp(item.name,pre,n)=FALSE THEN RETURN
  697.         item:=.next
  698.     ENDWHILE
  699.  
  700.     item:=first
  701.     WHILE item
  702.         item.name+=n
  703.         item:=.next
  704.     ENDWHILE
  705. ENDPROC
  706.  
  707. PROC WriteENUM(f,enum:PTR TO enum)
  708.     DEF    const:PTR TO const,value=0
  709.     const:=enum.first
  710.     FPrintF(f,'ENUM\t',NIL)
  711.     WHILE const
  712.         IF const<>enum.first THEN FPrintF(f,'\t\t',NIL)
  713.         FPrintF(f,'\s',const.name)
  714.         IF const.value<>value
  715.             FPrintF(f,'=\d',const.value)
  716.             value:=const.value
  717.         ENDIF
  718.         value++
  719.         const:=const.next
  720.         IF const THEN FPrintF(f,',',NIL)
  721.         FPrintF(f,'\n',NIL)
  722.     ENDWHILE
  723.     FPrintF(f,'\n',NIL)
  724. ENDPROC
  725.  
  726. PROC WriteMacro(f,macro:PTR TO macro)
  727.     SELECT macro.type
  728.     CASE MT_define
  729.         DEF    line:PTR TO mline
  730.         FPrintF(f,'#define \s\s',macro.name,macro.args)
  731.         line:=macro.mline
  732.         WHILE line
  733.             FPrintF(f,' \s',line.data)
  734.             IF line.next THEN FPrintF(f,'\\',NIL)
  735.             IF line.comment
  736.                 FPrintF(f,'\t',NIL)
  737.                 WriteD(f,line.comment)
  738.             ELSE FPrintF(f,'\n',NIL)
  739.             line:=.next
  740.             CtrlC()
  741.         ENDWHILE
  742.     CASE MT_include
  743.         IFN StrCmp(macro.name,'exec/types') THEN FPrintF(f,'MODULE\t''\s''\n',macro.name)
  744.     CASE MT_ifdef
  745.         FPrintF(f,'#ifdef \s\n',macro.name)
  746.     CASE MT_ifndef
  747.         FPrintF(f,'#ifndef \s\n',macro.name)
  748.     CASE MT_endif
  749.         FPrintF(f,'#endif\n',NIL)
  750.     ENDSELECT
  751. ENDPROC
  752.  
  753. PROC WriteCONST(f,const:PTR TO oconst)(PTR TO oconst)
  754.     FPrintF(f,'CONST\t\s=\d',const.name,const.value)
  755.     IF const.next
  756.         IF const.next.what=DA_OConst
  757.             IF const:=.next
  758.                 WHILE const.what=DA_OConst
  759.                     FPrintF(f,',\n\t\t\s=\d',const.name,const.value)
  760.                 EXITIF const.next=NIL
  761.                     const:=.next
  762.                 ENDWHILE
  763.             ENDIF
  764.             FPrintF(f,'\n',NIL)
  765.         ENDIF
  766.     ELSE FPrintF(f,'\n',NIL)
  767. ENDPROC const
  768.  
  769. PROC WriteTDEF(f,tdef:PTR TO typedef)
  770.     FPrintF(f,'TDEF\t\s:\s',tdef.name,TypeStr(tdef.type))
  771.     IF tdef.obj THEN FPrintF(f,'\s\n',tdef.obj)
  772.     FPrintF(f,'\n',NIL)
  773.     IF tdef.object THEN WriteOBJECT(f,tdef.object)
  774. ENDPROC
  775.  
  776. PROC ItemLen(item:PTR TO item)(L)
  777.     DEF    l,ptr
  778.     l:=StrLen(item.name)
  779.     IF item.size THEN l+=StrLen(item.size)+2
  780.     IF item.obj THEN l+=StrLen(item.obj)
  781.     SELECT item.type&$1f                                        // add ':type'
  782.     CASE DT_PTR;                                                l+=4
  783.     CASE DT_LONG,DT_WORD,DT_BYTE,DT_BOOL,DT_VOID;    l+=5
  784.     CASE DT_ULONG,DT_UWORD,DT_UBYTE,DT_FLOAT;            l+=6
  785.     CASE DT_DOUBLE;                                            l+=7
  786.     DEFAULT;                                                        l++
  787.     ENDSELECT
  788.     ptr:=item.type>>5
  789.     l+=ptr*7                    // length of 'PTR TO '
  790. ENDPROC l
  791.  
  792. PROC TypeStr(type)(PTR TO CHAR)
  793.     DEF    str:PTR TO CHAR
  794.     SELECT type
  795.     CASE 1;    str:='LONG'
  796.     CASE 2;    str:='ULONG'
  797.     CASE 3;    str:='WORD'
  798.     CASE 4;    str:='UWORD'
  799.     CASE 5;    str:='BYTE'
  800.     CASE 6;    str:='UBYTE'
  801.     CASE 7;    str:='FLOAT'
  802.     CASE 8;    str:='DOUBLE'
  803.     CASE 9;    str:='BOOL'
  804.     CASE 10;    str:=NIL
  805.     CASE 11;    str:='PTR'
  806.     CASE 12;    str:='DLONG'
  807.     CASE 13;    str:='UDLONG'
  808.     CASE 14;    str:='STRING'
  809.  
  810.     CASE 33;    str:='PTR TO LONG'
  811.     CASE 34;    str:='PTR TO ULONG'
  812.     CASE 35;    str:='PTR TO WORD'
  813.     CASE 36;    str:='PTR TO UWORD'
  814.     CASE 37;    str:='PTR TO BYTE'
  815.     CASE 38;    str:='PTR TO UBYTE'
  816.     CASE 39;    str:='PTR TO FLOAT'
  817.     CASE 40;    str:='PTR TO DOUBLE'
  818.     CASE 41;    str:='PTR TO BOOL'
  819.     CASE 42;    str:='PTR TO '
  820.     CASE 43;    str:='PTR TO PTR'
  821.     CASE 44;    str:='PTR TO DLONG'
  822.     CASE 45;    str:='PTR TO UDLONG'
  823.     CASE 46;    str:='PTR TO CHAR'
  824.  
  825.     CASE 65;    str:='PTR TO PTR TO LONG'
  826.     CASE 66;    str:='PTR TO PTR TO ULONG'
  827.     CASE 67;    str:='PTR TO PTR TO WORD'
  828.     CASE 68;    str:='PTR TO PTR TO UWORD'
  829.     CASE 69;    str:='PTR TO PTR TO BYTE'
  830.     CASE 70;    str:='PTR TO PTR TO UBYTE'
  831.     CASE 71;    str:='PTR TO PTR TO FLOAT'
  832.     CASE 72;    str:='PTR TO PTR TO DOUBLE'
  833.     CASE 73;    str:='PTR TO PTR TO BOOL'
  834.     CASE 74;    str:='PTR TO PTR TO '
  835.     CASE 75;    str:='PTR TO PTR TO PTR'
  836.     CASE 76;    str:='PTR TO PTR TO DLONG'
  837.     CASE 77;    str:='PTR TO PTR TO UDLONG'
  838.     CASE 78;    str:='PTR TO PTR TO CHAR'
  839.  
  840.     CASE 129;str:='LIST OF LONG'
  841.     CASE 130;str:='LIST OF ULONG'
  842.     CASE 131;str:='LIST OF WORD'
  843.     CASE 132;str:='LIST OF UWORD'
  844.     CASE 133;str:='LIST OF BYTE'
  845.     CASE 134;str:='LIST OF UBYTE'
  846.     CASE 135;str:='LIST OF FLOAT'
  847.     CASE 136;str:='LIST OF DOUBLE'
  848.     CASE 137;str:='LIST OF BOOL'
  849.     CASE 138;str:='LIST OF '
  850.     CASE 139;str:='LIST OF PTR'
  851.     CASE 140;str:='LIST OF DLONG'
  852.     CASE 141;str:='LIST OF UDLONG'
  853.     CASE 142;str:='LIST OF CHAR'
  854.     DEFAULT;    str:='VOID'
  855.     ENDSELECT
  856. ENDPROC str
  857.  
  858. PROC GetNum(s:PTR TO CHAR,n=0,l)(LONG,LONG)
  859.     DEF    num=0,sign=1
  860.     WHILE s[n]="\t" OR s[n]="\n" OR s[n]=" " DO n++
  861.     IF s[n]="-"
  862.         sign:=-1
  863.         n++
  864.     ENDIF
  865.     IF s[n]="0" AND s[n+1]="x"                                    // HEXADECIMAL number
  866.         n+++
  867.         WHILE s[n]>="0" AND s[n]<="9"
  868.             num<<=4
  869.             num|=s[n]-"0"
  870.         ELSEWHILE s[n]>="a" AND s[n]<="f"
  871.             num<<=4
  872.             num|=s[n]-"a"+10
  873.         ELSEWHILE s[n]>="A" AND s[n]<="F"
  874.             num<<=4
  875.             num|=s[n]-"A"+10
  876.         ALWAYS
  877.             n++
  878.             IF n>l THEN Raise("EOF",n)
  879.         ENDWHILE
  880.     ELSE                                                                // DECIMAL number
  881.         WHILE s[n]>="0" AND s[n]<="9"
  882.             num*=10
  883.             num+=s[n]-"0"
  884.             n++
  885.             IF n>l THEN Raise("EOF",n)
  886.         ENDWHILE
  887.     ENDIF
  888. ENDPROC n,num*sign
  889.  
  890. PROC GetName(name:PTR TO CHAR,src:PTR TO CHAR,pos,length)(L,PTR)
  891.     DEF i=0
  892.     IF name
  893.         IF IsAlpha(src[pos])
  894.             WHILE IsAlphaNum(src[pos])
  895.                 name[i]:=src[pos]
  896.                 pos++
  897.                 i++
  898.                 CtrlC()
  899.                 IF pos>length THEN Raise("EOF",pos)
  900.             ENDWHILE
  901.             name[i]:="\0"
  902.         ENDIF
  903.     ELSE
  904.         IF IsAlpha(src[pos])
  905.             WHILE IsAlphaNum(src[pos])
  906.                 pos++
  907.                 CtrlC()
  908.                 IF pos>length THEN Raise("EOF",pos)
  909.             ENDWHILE
  910.             name:=TRUE
  911.         ENDIF
  912.     ENDIF
  913. ENDPROC pos,name
  914.  
  915. PROC GetString(str:PTR TO CHAR,src:PTR TO CHAR,pos,length)(L,PTR)
  916.     DEF i=0
  917.     IF (src[pos]=34)||(src[pos]="<")
  918.         pos++
  919.         WHILE (src[pos]<>34)&&(src[pos]<>">")
  920.             str[i]:=src[pos]
  921.             pos++
  922.             i++
  923.             CtrlC()
  924.             IF pos>length THEN Raise("EOF",pos)
  925.         ENDWHILE
  926.         str[i]:="\0"
  927.         pos++                // skip ",>
  928.     ENDIF
  929. ENDPROC pos,str
  930.  
  931. PROC Find(char,src:PTR TO CHAR,pos,length)(L)
  932.     WHILE src[pos]<>char
  933.         pos++
  934.         CtrlC()
  935.         IF pos>length THEN Raise("EOF",pos)
  936.     ENDWHILE
  937. ENDPROC pos
  938.  
  939. PROC IsAlpha(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||(char="#") THEN TRUE ELSE FALSE
  940. PROC IsAlphaNum(char)(L) IS IF ((char>="A")&&(char<="Z"))||((char>="a")&&(char<="z"))||(char="_")||((char>="0")&&(char<="9"))||(char="#") THEN TRUE ELSE FALSE
  941. PROC IsFirstNum(char)(L) IS IF ((char>="0")&&(char<="9"))||(char=".")||(char="$")||(char="%")||(char="-") THEN TRUE ELSE FALSE
  942.  
  943. // skip whitespaces and comments
  944. PROC Skip(src:PTR TO CHAR,pos,length)(L)
  945.     DEF done=FALSE,char
  946.     REPEAT
  947.         char:=src[pos]
  948.         IF char=" "
  949.             pos++
  950.         ELSEIF char="\t"
  951.             pos++
  952.         ELSEIF char=";"
  953.             pos++
  954.         ELSEIF char="\n"
  955.             pos++
  956.         ELSEIF char="/"
  957.             IF src[pos+1]="*"
  958.                 pos++
  959.                 REPEAT
  960.                     pos++
  961.                     IF pos>length THEN RETURN pos
  962.                 UNTIL (src[pos-1]="*")&&(src[pos]="/")
  963.                 pos++
  964.             ELSEIF src[pos+1]="/"
  965.                 pos++
  966.                 REPEAT
  967.                     pos++
  968.                     IF pos>length THEN RETURN pos
  969.                 UNTIL (src[pos]="\n")||((src[pos-1]="/")&&(src[pos]="/"))
  970.                 pos++
  971.             ELSE
  972.                 done:=TRUE
  973.             ENDIF
  974.         ELSE
  975.             done:=TRUE
  976.         ENDIF
  977.         IF pos>length THEN Raise("EOF",pos)
  978.     UNTIL done=TRUE
  979. ENDPROC pos
  980.  
  981. // skip whitespaces only
  982. PROC Crop(src:PTR TO CHAR,pos,length)(L)
  983.     DEF done=FALSE,char
  984.     REPEAT
  985.         char:=src[pos]
  986.         IF char=" "
  987.             pos++
  988.         ELSEIF char="\t"
  989.             pos++
  990.         ELSEIF char=";"
  991.             pos++
  992.         ELSEIF char="\n"
  993.             pos++
  994.         ELSE
  995.             done:=TRUE
  996.         ENDIF
  997.         IF pos>length THEN Raise("EOF",pos)
  998.     UNTIL done=TRUE
  999. ENDPROC pos
  1000.  
  1001. PROC MaCrop(src:PTR TO CHAR,pos,length)(L)
  1002.     DEF    cpos=-1,qpos=-1,apos=-1
  1003.     WHILE src[pos]<>"\n"
  1004.         IF src[pos]="/" AND src[pos+1]="/" THEN cpos:=0
  1005.         IF src[pos]="/" AND src[pos+1]="*" THEN cpos:=0
  1006.         IF src[pos]="*" AND src[pos+1]="/" THEN cpos:=-1
  1007.         IF src[pos]="\q" THEN qpos:=~qpos
  1008.         IF src[pos]="\a" THEN apos:=~apos
  1009.         IF src[pos]="\\" THEN IF cpos=-1 AND qpos=-1 AND apos=-1 THEN RETURN pos
  1010.         pos++
  1011.         IF pos>length THEN Raise("EOF",pos)
  1012.     ENDWHILE
  1013. ENDPROC pos
  1014.  
  1015. PROC Optimize(first:PTR TO data)(PTR)
  1016.     DEF    prev=NIL:PTR TO data,data=first:PTR TO data,cnst:PTR TO oconst
  1017.     DEF    macro:PTR TO macro,mline:PTR TO mline,bool:BOOL,flt:BOOL,value
  1018.  
  1019.     // change all number-only macros to constants
  1020.     WHILE data
  1021.         IF data.what=DA_Macro
  1022.             macro:=data
  1023.             IF macro.type=MT_define && macro.args=NIL
  1024.                 IF mline:=macro.mline
  1025.                     IF mline.next=NIL
  1026.                         IF bool,flt:=CheckNumber(mline.data)
  1027.                             IFN flt
  1028.                                 cnst:=AllocPooled(pool,SIZEOF_oconst)
  1029.                                 cnst.what:=DA_OConst
  1030.                                 cnst.next:=data.next
  1031.                                 cnst.name:=macro.name
  1032.                                 value:=Val(mline.data)
  1033.                                 cnst.value:=value
  1034.                                 cnst.comment:=mline.comment
  1035.                                 IF prev THEN prev.next:=cnst ELSE first:=cnst
  1036.                                 data:=cnst
  1037.                             ENDIF
  1038.                         ENDIF
  1039.                     ENDIF
  1040.                 ENDIF
  1041.             ENDIF
  1042.         ENDIF
  1043.         prev:=data
  1044.         data:=.next
  1045.         CtrlC()
  1046.     ENDWHILE
  1047. ENDPROC first
  1048.  
  1049. PROC CheckNumber(str:PTR TO CHAR)(BOOL,BOOL)
  1050.     DEF    number=TRUE:BOOL,n=0,float=FALSE:BOOL
  1051.     n:=Crop(str,0,StrLen(str))
  1052.     IF IsFirstNum(str[n])
  1053.         n++
  1054.         WHILE str[n]
  1055.             IF IsHex(str[n])
  1056.             ELSEIF str[n]=".";    float:=TRUE
  1057.             ELSE number:=FALSE
  1058.             n++
  1059.         ENDWHILE
  1060.     ELSE number:=FALSE
  1061. ENDPROC number,float
  1062.  
  1063. PROC ComputeMacro(first:PTR TO data,macro:PTR TO macro)
  1064.     DEF    line:PTR TO mline,name[64]:STRING,pos,len,npos
  1065.     DEF    value
  1066.     line:=macro.mline
  1067.     WHILE line
  1068.         pos:=0
  1069.         len:=StrLen(line.data)
  1070. //        pos:=Crop(line.data,pos,len)
  1071.         value:=0
  1072.         WHILE (npos:=GetName(name,line.data,pos,len))>pos
  1073.             SELECT TRUE
  1074.             CASE StrCmp(name,'TAG_USER');    value|=$80000000
  1075.             DEFAULT
  1076.             ENDSELECT
  1077.         ENDWHILE
  1078.         line:=.next
  1079.         CtrlC()
  1080.     ENDWHILE
  1081. ENDPROC
  1082.